Option Explicit
Sub F_Sample042()
   'Microsoft ActiveX Data Objects 2.X Library ]wޥζ
   'Microsoft ADO Ext. 2.1 for DDL and Security ]wޥζ
   'ոƦbF_Sample032s@XӪNewDB.mdb
   'ոƦbF_Sample036һs@XӪwq ADO_TABLEDEF
    Dim myCon      As New ADODB.Connection
    Dim myCat      As New ADOX.Catalog
    Dim mytbl   As New ADOX.Table
    Dim myClm   As ADOX.Column
    Dim myIdx   As New ADOX.Index
    Dim mySht   As Worksheet
    Dim i       As Long
    Dim myFileName As String
    myFileName = "NewDB.mdb"                                   'wɮצW
    'wq
    On Error Resume Next
    Set mySht = Worksheets("ADO_TABLEDEF")     'wW
    On Error GoTo 0
    If mySht Is Nothing Then
        MsgBox "Swqsb"
        Exit Sub
    End If
    mySht.Activate
    myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & ThisWorkbook.Path & "\" & myFileName & ";"
    Set myCat.ActiveConnection = myCon
    On Error Resume Next
   'RJs
    myCat.Tables.Delete Cells(2, 1).Value
    On Error GoTo 0
   'إ߯
    myIdx.Name = "PrimaryKey"
    myIdx.PrimaryKey = True
    With mytbl
        .Name = Cells(2, 1).Value
        For i = 3 To Range("A1").End(xlDown).Row
            Set myClm = New Column
            myClm.Name = Cells(i, 2).Value
            myClm.Type = GetConstNo_ADO(Cells(i, 3).Value)
            If Cells(i, 4).Value > 0 Then
                myClm.DefinedSize = Cells(i, 4).Value
                myClm.Attributes = adColNullable
            End If
            .Columns.Append myClm
            If Cells(i, 6).Value = "P" Then
                myIdx.Columns.Append Cells(i, 2).Value
            End If
        Next
    End With
   'Nީwqxs椺
    myCat.Tables.Append mytbl
    mytbl.Indexes.Append myIdx
    myCon.Close
    Set mySht = Nothing                                        '
    Set myIdx = Nothing
    Set mytbl = Nothing
    Set myCon = Nothing
    Set myCat = Nothing
End Sub
Function GetConstNo_ADO(myStr As String) As Integer
    Dim myInt As Integer
    Select Case myStr
        Case "adBigInt": myInt = 20
        Case "adBinary": myInt = 128
        Case "adBoolean": myInt = 11
        Case "adBSTR": myInt = 8
        Case "adChapter": myInt = 136
        Case "adChar": myInt = 129
        Case "adCurrency": myInt = 6
        Case "adDate": myInt = 7
        Case "adDBDate": myInt = 133
        Case "adDBTime": myInt = 134
        Case "adDBTimeStamp": myInt = 135
        Case "adDecimal": myInt = 14
        Case "adDouble": myInt = 5
        Case "adEmpty": myInt = 0
        Case "adError": myInt = 10
        Case "adFileTime": myInt = 64
        Case "adGUID": myInt = 72
        Case "adIDispatch": myInt = 9
        Case "adInteger": myInt = 3
        Case "adIUnknown": myInt = 13
        Case "adLongVarBinary": myInt = 205
        Case "adLongVarChar": myInt = 201
        Case "adLongVarWChar": myInt = 203
        Case "adNumeric": myInt = 131
        Case "adPropVariant": myInt = 138
        Case "adSingle": myInt = 4
        Case "adSmallInt": myInt = 2
        Case "adTinyInt": myInt = 16
        Case "adUnsignedBigInt": myInt = 21
        Case "adUnsignedInt": myInt = 19
        Case "adUnsignedSmallInt": myInt = 18
        Case "adUnsignedTinyInt": myInt = 17
        Case "adUserDefined": myInt = 132
        Case "adVarBinary": myInt = 204
        Case "adVarChar": myInt = 200
        Case "adVariant": myInt = 12
        Case "adVarNumeric": myInt = 139
        Case "adVarWChar": myInt = 202
        Case "adWChar": myInt = 130
        Case Else: myInt = -1
    End Select
    GetConstNo_ADO = myInt
End Function


